home *** CD-ROM | disk | FTP | other *** search
/ CD ROM Paradise Collection 4 / CD ROM Paradise Collection 4 1995 Nov.iso / program / swags_z.zip / SCROLL.SWG / 0016_Tweaked Text Scroll.pas < prev    next >
Pascal/Delphi Source File  |  1994-02-05  |  2KB  |  66 lines
  1.  
  2. program heavily_tweaked_textscroll;
  3. uses crt;
  4. const sseg : word = $b800; hi = 16; grd = 3; wideness = 1;
  5.   grade : string = '.:|X#';
  6.   txt : string = 'This simple old text scroll is really getting tweaked!'
  7.                + '      In fact, it''s not so simple anymore...         ';
  8.  
  9. var fseg, fofs : word; idx : word; i, cur, line, bitpos : byte;
  10.     jcol : byte; ch : char; widecount : byte;
  11.  
  12. procedure getfont; assembler; asm
  13.   mov ax,1130h; mov bh,3; int 10h; mov fseg,es; mov fofs,bp; end;
  14.  
  15. procedure retrace; assembler; asm
  16.   mov dx,3dah;
  17.   @l1: in al,dx; test al,8; jnz @l1;
  18.   @l2: in al,dx; test al,8; jz @l2; end;
  19.  
  20. procedure moverowleft(startingrow : word); assembler;
  21. asm  { sorry, I had to smush it a bit }
  22.   push  ds;  push  es  { do I really need to save es? }
  23.   mov   ax,$b800;  mov   es,ax;  mov   ds,ax;  mov   cx,0003
  24.   @@MoveByte:
  25.     add   cx,startingrow;  mov   di,cx;       mov   al,[es:di]
  26.     sub   cx,startingrow;  sub   cx,2;        add   cx,startingrow
  27.     mov   si,cx;           mov   [ds:si],al;  sub   cx,startingrow
  28.     add   cx,4;            cmp   cx,160
  29.   jl    @@MoveByte
  30.   pop   es;  pop   ds
  31. end;
  32.  
  33.  
  34. begin
  35.   getfont; textattr := 15; clrscr;
  36.   fillchar(mem[$b800:0],4000,0);
  37.   for idx := hi to (hi+7) do for jcol := 0 to length(grade)-1 do begin
  38.     for i := grd*jcol to 79-(grd*jcol) do
  39.       mem[sseg:idx*160+i*2] := Ord(grade[jcol+1]);
  40.   end;
  41.   idx := 1; jcol := 15;
  42.   repeat
  43.     cur := ord(txt[idx]);
  44.     inc(jcol); if (jcol > 15) then jcol := 1;
  45.     bitpos := 0;
  46.     repeat
  47.       for widecount := 1 to wideness do begin
  48.         for line := 0 to 7 do begin
  49.           (* jcol := random(14) + 1; *)
  50.           if ((mem[fseg:fofs+cur*8+line] shl bitpos) and 128) <> 0 then
  51.             mem[sseg:158+(line+hi)*160+1] := jcol
  52.           else
  53.             mem[sseg:158+(line+hi)*160+1] := 0;
  54.         end;
  55.         retrace;
  56.         for line := 0 to 7 do moverowleft((line+hi)*160);
  57.       end;
  58.       inc(bitpos);
  59.     until (bitpos > 7) or keypressed;
  60.     if not keypressed then idx := 1 + idx mod length(txt);
  61.   until keypressed;
  62.   while keypressed do ch := readkey;
  63.   textattr := 7; clrscr;
  64. end.
  65.  
  66.